perm filename S5X.FOR[P11,LCS] blob
sn#414664 filedate 1979-01-30 generic text, type T, neo UTF8
C ***** SUBROUTINES TO GO WITH S3X.F4 (RUNIT) *******
C* MICRO, RMOVX, ALL, POINTR, RAND,PARAM 7/78
FUNCTION RMOVX(W,Y,Z)
IF(W.EQ.0)W=.01
IF(Y.EQ.0)Y=.01
RMOVX=Y*((W/Y)**Z)
END
FUNCTION ALL(JPT,IPTX)
COMMON /VV/LIMIT,V(1)
DIMENSION JPT(1)
K=IPTX-1
IF(K.GT.0)GO TO 2
1 K=JPT(-K)
IF(K)GO TO 1
C FOR 'ALL' WITH RR,RD,DF. FOLLOWS UP ON POINTERS TO POINTERS!
K=K-1
2 ALL=PARAM(V(K+3),K)
END
C***** THIS IS NOW A 'FAIL' ROUTINE IN SPRINT.FAI
FUNCTION PARAM(X,K)
COMMON J,L /P/P(1) /PL/IPL(1) /C/T,NWZZ,IT3,T6,NW,TDUR,A,
1 T2,T4,BY,KODE,NPAR,LP,TBG,AC,NPA,BX,IDF,IPM,NM,PAR,PX2
K=0
C IF K IS NOT ZERO UPON RETURN, THEN WE'VE FOUND INFO IN OTHER PARAM.
PARAM=X
IF(X.GT.-9999.0)RETURN
IF(X.EQ.-10000.0)RETURN
K=-(X+9999.0)*100.+.1
PARAM=P(K)
C GET DATA FROM PARAM K
IPM=IPL(K)
IF(L.NE.2)RETURN
C L=CALLING PARAM NUM., K=PARAM REFERRED TO.
IF(K.EQ.2)PARAM=PX2
C MUST USE 'UNPROCESSED' FORM OF P2 (I.E. NO 'TEMPO' CHANGES)
END
C***** MICROTONES ********
SUBROUTINE MICRO
COMMON INUM,IPAR /P/P(1) /PL/IPL(2),IPL3
C CALL SUBROUTINE FROM ANY PARAMETER WHERE THE CALLING PARAMETER
C AND THE IMMEDITELY PRECEDING PARAMETER ARE UNUSED BY YOUR INSTR.
C P3 CAN BE NOTES OR NUMBS.
X=P(3)
IF(IPL3.EQ.1)GO TO 1
CC X=IFIX(X)
C FOR RAND NOTES TO LOCK ON NOTE NUMBERS.
CC X=30.8677*2**(X/12)
X=15.43385*2**(X/12)
C X=FREQ. IN HZ. BASED ON NT # IN P3. NUM. ABOVE IS B, IE. LOWEST B -1 OCT.
IPL3=1
C THIS CAUSES FREQ. NUM TO PRINT INSTEAD OF LITERAL CHARACTERS.
1 Y=IFIX(P(IPAR-1))
Z=IFIX(P(IPAR))
C FIX NEEDED BECAUSE OF POSSIBLE NON-INTEGERS HERE.
P(3)=X*2**(Y/Z)
C IPAR (Z) IS THE CALLING PARAMETER. IPAR-1 (Y) THE PREVIOUS PARAM.
C X HAS BASE FREQ.
C THE NUMBER IN P(IPAR)=# OF DIVISIONS OF THE OCTAVE.
C THE NUMBER IN P(IPAR-1)=CHROMATIC STEP IN THAT DIV.
END
FUNCTION RAND(A,B)
RAND=A+(B-A)*RAN(B)
C RAN IS IN FORTRAN LIB.
END